VERSION = 3.00 appbldr.h>i]Y)apphook appbldr.hPixelsClass1 projecthookapphook projecthook)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 _folderPixelsClass7 container_folder_folderlabel _shortcutmenulabelcustomcheckbox _shortcutmenuPixelsClasscustomchkCreateProjDircheckbox_foldercmdProjectFile commandbutton commandbutton1LHeight = 22 Width = 24 conselection = cmenu = Name = "_shortcutmenu" PROCEDURE deactivatemenu IF EMPTY(this.cMenu) RETURN ENDIF DEACTIVATE POPUP (this.cMenu) this.cMenu="" DOEVENTS ENDPROC PROCEDURE activatemenu LPARAMETERS tcParentMenu LOCAL lnArrayColumns,llMultiArray,lnBar,lnSkipCount,lnCount,lnMRow,lnMCol LOCAL lnMenuCount,lcMenu,lcMenu2,lcMenuItem,luMenuSelection,llSetMark,lcClauses lnMRow=MAX(MROW(),0) lnMCol=MAX(MCOL(),0) IF TYPE("this.aMenu")#"C" RETURN .F. ENDIF lnMenuCount=ALEN(this.aMenu,1) IF lnMenuCount=0 RETURN .F. ENDIF lcMenu=IIF(EMPTY(tcParentMenu),SYS(2015),ALLTRIM(tcParentMenu)) this.cMenu=lcMenu lnArrayColumns=ALEN(this.aMenu,2) llMultiArray=(lnArrayColumns>0) DEACTIVATE POPUP (lcMenu) CLEAR TYPEAHEAD IF EMPTY(tcParentMenu) DEFINE POPUP (lcMenu) ; FROM lnMRow,lnMCol ; MARGIN ; SHORTCUT ON SELECTION POPUP (lcMenu) DEACTIVATE MENU (lcMenu) ENDIF lnSkipCount=0 FOR lnCount = 1 TO lnMenuCount lcMenuItem=IIF(llMultiArray,this.aMenu[lnCount,1],this.aMenu[lnCount]) IF TYPE("lcMenuItem")#"C" OR EMPTY(lcMenuItem) OR ; ((lnCount=1 OR lnCount=lnMenuCount) AND ALLTRIM(lcMenuItem)=="\-") lnSkipCount=lnSkipCount+1 LOOP ENDIF lnBar=lnCount-lnSkipCount llSetMark=.F. IF LEFT(lcMenuItem,1)=="^" lcMenuItem=SUBSTR(lcMenuItem,2) llSetMark=.T. ENDIF IF lnArrayColumns>=3 AND NOT EMPTY(this.aMenu[lnCount,3]) lcClauses=ALLTRIM(this.aMenu[lnCount,3]) ELSE lcClauses="" ENDIF IF EMPTY(lcClauses) DEFINE BAR lnBar OF (lcMenu) PROMPT (lcMenuItem) ELSE DEFINE BAR lnBar OF (lcMenu) PROMPT (lcMenuItem) &lcClauses ENDIF IF llSetMark SET MARK OF BAR (lnBar) OF (lcMenu) TO .T. ENDIF IF NOT llMultiArray LOOP ENDIF luMenuSelection=this.aMenu[lnCount,2] IF TYPE("luMenuSelection")=="O" AND NOT ISNULL(luMenuSelection) lcMenu2=SYS(2015) DEFINE POPUP (lcMenu2) ; MARGIN ; SHORTCUT ON SELECTION POPUP (lcMenu2) DEACTIVATE MENU (lcMenu2) ON BAR lnBar OF (lcMenu) ACTIVATE POPUP (lcMenu2) IF EMPTY(luMenuSelection.cOnSelection) luMenuSelection.cOnSelection=this.cOnSelection ENDIF luMenuSelection.ActivateMenu(lcMenu2) LOOP ENDIF IF EMPTY(luMenuSelection) luMenuSelection=ALLTRIM(this.cOnSelection) ENDIF IF NOT EMPTY(luMenuSelection) ON SELECTION BAR lnBar OF (lcMenu) &luMenuSelection ENDIF ENDFOR IF lnSkipCount>=lnMenuCount OR NOT EMPTY(tcParentMenu) RETURN ENDIF ACTIVATE POPUP (lcMenu) IF NOT EMPTY(this.cMenu) DEACTIVATE POPUP (this.cMenu) ENDIF this.cMenu="" DOEVENTS ENDPROC PROCEDURE clearmenu DIMENSION this.aMenu[1] this.aMenu="" this.cOnSelection="" ENDPROC PROCEDURE newmenu LOCAL toObject LOCAL oNewObject,lcClass,lcClassLibrary,lcBaseClass,lcAlias,llAddLibrary IF TYPE("toObject")#"O" OR ISNULL(toObject) toObject=this ENDIF lcClass=LOWER(toObject.Class) lcClassLibrary=LOWER(toObject.ClassLibrary) lcBaseClass=LOWER(toObject.BaseClass) IF EMPTY(lcClassLibrary) oNewObject=CREATEOBJECT(lcBaseClass) RETURN oNewObject ENDIF lcAlias=LOWER(SYS(2015)) llAddLibrary=(ATC(lcClassLibrary,SET("CLASSLIB"))=0) IF llAddLibrary SET CLASSLIB TO (lcClassLibrary) ALIAS (lcAlias) ADDITIVE ENDIF oNewObject=CREATEOBJECT(lcClass) IF llAddLibrary RELEASE CLASSLIB ALIAS (lcAlias) ENDIF RETURN oNewObject ENDPROC PROCEDURE addmenubar LPARAMETERS tcPrompt,tcOnSelection,tcClauses,tnElementNumber,tlMark,tlDisabled,tlBold LOCAL lcPrompt,lcClauses,lnElementNumber,lnMenuCount,lnArrayColumns,lnIndex,oShortCutMenu IF EMPTY(tcPrompt) RETURN .F. ENDIF IF TYPE("tcPrompt")=="O" AND NOT ISNULL(tcPrompt) oShortCutMenu=tcPrompt tcPrompt=.NULL. FOR lnIndex = 1 TO ALEN(oShortCutMenu.aMenu,1) this.AddMenuBar(oShortCutMenu.aMenu[lnIndex,1],oShortCutMenu.aMenu[lnIndex,2], ; oShortCutMenu.aMenu[lnIndex,3]) ENDFOR RETURN ENDIF lcPrompt=tcPrompt lcClauses=IIF(EMPTY(tcClauses),"",tcClauses) IF tlMark lcPrompt="^"+lcPrompt ENDIF IF tlDisabled lcClauses=lcClauses+[ SKIP FOR .T.] ENDIF IF tlBold lcClauses=lcClauses+[ STYLE "B"] ENDIF lnMenuCount=ALEN(this.aMenu,1) lnArrayColumns=ALEN(this.aMenu,2) IF lnMenuCount<=1 AND EMPTY(this.aMenu[1]) lnMenuCount=1 lnArrayColumns=3 ELSE lnMenuCount=lnMenuCount+1 ENDIF lnIndex=lnMenuCount DIMENSION this.aMenu[lnIndex,lnArrayColumns] IF TYPE("tnElementNumber")=="N" lnElementNumber=MAX(INT(tnElementNumber),1) IF lnElementNumber=3 this.aMenu[lnIndex,3]=lcClauses ENDIF ENDPROC PROCEDURE addmenuseparator LPARAMETERS tnElementNumber this.AddMenuBar("\-",,,tnElementNumber) ENDPROC PROCEDURE showmenu RETURN this.ActivateMenu() ENDPROC PROCEDURE setmenu LPARAMETERS toObject this.ClearMenu RETURN .F. ENDPROC PROCEDURE Init this.ClearMenu ENDPROC  t % tU?%CBuTUTHISCMENUW     TCCDTCCD%C this.aMenubCB-TC%B-"T CC C]C6T TCT u %Cys W'1 DEACTIVATE MENU (lcMenu) T(.T CC C6N%C lcMenuItembCC $  C \-  2T.T T -%C =^T C \ T a&%CC TCC T%C s " Q?DEFINE BAR lnBar OF (lcMenu) PROMPT (lcMenuItem) &lcClauses  % zG: (a% .T C-%CluMenuSelectionbOC uT C] s W(1 DEACTIVATE MENU (lcMenu2)1  %C \T C .%C T C%C 7ON SELECTION BAR lnBar OF (lcMenu) &luMenuSelection %C  B t %C <uTU TCPARENTMENULNARRAYCOLUMNS LLMULTIARRAYLNBAR LNSKIPCOUNTLNCOUNTLNMROWLNMCOL LNMENUCOUNTLCMENULCMENU2 LCMENUITEMLUMENUSELECTION LLSETMARK LCCLAUSESTHISAMENUCMENU CONSELECTION ACTIVATEMENU3TTUTHISAMENU CONSELECTIONK%%CtoObjectbOC T TTC@TC @TC @%CTCN BTCC]@!TCCCLASSLIBv %G~(TCN %; ()+|C" C' TTC% TTCDULCVALUE LCPROJECTFILE LCBADCHARS LNSELSTARTTHISSELSTARTVALUE TC UTHISENABLEDPARENTTXTPROJECTNAMEVALUETC.TCC PJX C6%C BC 0%\ : C\ B-TCCCC곛TCCC՛%C\\B5TC\\\CC\\6TCC@% }TBCC֡ U LCVALUELCEXT LCPROJECTFILE LCPROJECTPATHTHISVALUEPARENTCEXTTXTPROJECTNAMEINTERACTIVECHANGEInteractiveChange,Refresh2Valid11a"A331"AqAQQAQ!A2K i )oPROCEDURE InteractiveChange LOCAL lcValue,lcProjectFile,lcBadChars,lnSelStart lnSelStart=this.SelStart lcBadChars="?/,=;{}[]!@#$%^&*<>()+|"+CHR(34)+CHR(39) lcValue=this.Value lcProjectFile=CHRTRANC(lcValue,lcBadChars,"") IF NOT lcValue=lcProjectFile this.Value=lcProjectFile this.SelStart=MAX(lnSelStart-1,0) ENDIF ENDPROC PROCEDURE Refresh this.Enabled=(NOT EMPTY(this.parent.txtProjectName.Value)) ENDPROC PROCEDURE Valid LOCAL lcValue,lcExt,lcProjectFile,lcProjectPath lcValue=ALLTRIM(this.Value) lcExt = IIF(EMPTY(THIS.PARENT.cExt),"PJX",ALLTRIM(THIS.PARENT.cExt)) IF EMPTY(lcValue) this.parent.txtProjectName.InteractiveChange RETURN (NOT EMPTY(this.Value)) ENDIF IF lcValue=="\" OR lcValue==":" OR RIGHTC(lcValue,1)=="\" RETURN .F. ENDIF lcProjectFile=FORCEEXT(ALLTRIM(LEFTC(JUSTSTEM(lcValue),16)),lcExt) lcProjectPath=ADDBS(ALLTRIM(JUSTPATH(lcValue))) * check for invalid path (also handle network drives) IF RATC("\\",lcProjectPath)>1 lcProjectPath=STRTRAN(lcProjectPath,"\\","\",IIF(LEFTC(lcValue,2)="\\",2,1)) ENDIF lcProjectFile=LOWER(FORCEPATH(lcProjectFile,lcProjectPath)) IF NOT lcValue==lcProjectFile this.Value=lcProjectFile ENDIF RETURN NOT EMPTY(JustStem(lcValue)) ENDPROC FontName = "MS Sans Serif" FontSize = 8 Height = 22 InputMask = (REPLICATE("X",128)) Left = 10 TabIndex = 4 Top = 68 Width = 243 Name = "txtProjectFile" _foldertxtProjectFiletextboxtextboxFontName = "MS Sans Serif" FontSize = 8 FontExtend = .T. Caption = "Proj\()+|C" C' %C "TCC  TTCC %CTCC]C@%CCQ@TCC]\@%\ .T\#TCCCC 긛T C\% '!TCCC CF굛%C\TCCC곛%C@C@#T C\'TCC 곛\\&%: C\\ fTCC]@%C:\T\ %CC@ TT  U LCPROJECTDIR LCPROJECTDIR2 LCPROJECTDIR3 LCPROJECTFILELCPROJECTFILE2 LCBADCHARSLNATPOTHISPARENTCLASTPROJECTFILETRIMFILETXTPROJECTFILEVALUELNATPOSCEXTREFRESHCMDPROJECTFILE UTHISINTERACTIVECHANGEcTC%CC@CC@I TTU LCPROJECTFILETHISPARENTTXTPROJECTFILEVALUECLASTPROJECTFILE[ >%CC ?/\,=:;{}[]!@#$%^&*.<>()+|C" C' TB-UNKEYCODE NSHIFTALTCTRLValid,InteractiveChange$ProgrammaticChange GotFocus3KeyPress1q"QA!A13qBQ!A1aAA1!A1AAQAqAAaQAaAqAA33qA13AqA2G o5;7?>_ I) jPROCEDURE Valid LOCAL lcValue lcValue=ALLTRIM(this.Value) IF ":"$lcValue OR "\"$lcValue OR "."$lcValue this.Value=JustStem(ALLTRIM(lcValue)) ENDIF IF EMPTY(lcValue) AND NOT EMPTY(this.parent.txtProjectFile.Value) this.parent.txtProjectFile.Value=THIS.Parent.cLastProjectFile ENDIF THIS.Parent.cLastProjectFile="" ENDPROC PROCEDURE InteractiveChange LOCAL lcProjectDir,lcProjectDir2,lcProjectDir3,lcProjectFile,lcProjectFile2 LOCAL lcBadChars,lnAtPo lcBadChars=" ?/\,=:;{}[]!@#$%^&*.<>()+|"+CHR(34)+CHR(39) IF EMPTY(this.parent.cLastProjectFile) lcProjectDir=THIS.Parent.TrimFile(ALLTRIM(this.parent.txtProjectFile.Value)) lcProjectDir3=lcProjectDir lcProjectFile2=JustStem(ALLTRIM(this.parent.txtProjectFile.Value)) IF EMPTY(lcProjectDir) lcProjectDir=LOWER(SYS(5)+CURDIR()) IF lcProjectDir==LOWER(HOME()) lcProjectDir=LOWER(SYS(5)+"\") ENDIF ENDIF IF NOT "\"$lcProjectDir lcProjectDir="\"+lcProjectDir ENDIF lcProjectFile=ALLTRIM(CHRTRANC(LEFTC(ALLTRIM(this.Value),16),lcBadChars,"")) lnAtPos=AT_C("\",lcProjectDir) IF lnAtPos>0 lcProjectDir2=ALLTRIM(SUBSTRC(lcProjectDir,MIN(lnAtPos+1,LENC(lcProjectDir)))) IF RIGHTC(lcProjectDir2,1)=="\" lcProjectDir2=ALLTRIM(LEFTC(lcProjectDir2,LENC(lcProjectDir2)-1)) ENDIF IF LOWER(lcProjectDir2)==LOWER(lcProjectFile2) lnAtPos=AT_C("\",lcProjectDir3) lcProjectDir=ALLTRIM(LEFTC(lcProjectDir3,lnAtPos-1))+"\"+lcProjectFile+"\" ENDIF ENDIF IF NOT ":"$lcProjectDir AND LEFTC(lcProjectDir,2)#"\\" lcProjectDir=LOWER(SYS(5))+lcProjectDir ENDIF IF RIGHTC(lcProjectDir,2)==":\" lcProjectDir=lcProjectDir+lcProjectFile+"\" ENDIF IF NOT LOWER(RIGHTC(lcProjectFile,4))==THIS.PARENT.cExt lcProjectFile=lcProjectFile+THIS.PARENT.cExt ENDIF this.parent.txtProjectFile.Value=lcProjectDir+lcProjectFile ENDIF this.parent.txtProjectFile.Refresh this.parent.cmdProjectFile.Refresh ENDPROC PROCEDURE ProgrammaticChange this.InteractiveChange ENDPROC PROCEDURE GotFocus LOCAL lcProjectFile lcProjectFile=ALLTRIM(this.parent.txtProjectFile.Value) IF LOWER(JustStem(lcProjectFile))=LOWER(ALLTRIM(this.Value)) lcProjectFile="" ENDIF this.parent.cLastProjectFile=lcProjectFile ENDPROC PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl IF AT(CHR(nKeyCode),"?/\,=:;{}[]!@#$%^&*.<>()+|"+CHR(34)+CHR(39))>0 NODEFAULT RETURN .F. ENDIF ENDPROC FontName = "MS Sans Serif" FontSize = 8 Height = 22 InputMask = (REPLICATE("X",128)) Left = 10 TabIndex = 2 Top = 23 Width = 315 Name = "txtProjectName" _foldertxtProjectNametextboxtextboxFontName = "MS Sans Serif" FontSize = 8 Caption = "P\%"B-Ta<U LCBASECLASSTHISLRELEASEtrimfile,release1qAq3qAqAq2K )obuilder Object reference to application builder. cbuilder Property to override file name of application builder. lbypassbuilder Internal use. cproject Name of project. lautoupdate Whether to invoke application builder to automatically update meta table when project closed. csaveonkey Internal use. cformappobject_name Property to override name given to form mediator object. cformappobject_class Property to override name of class used for form mediator object. cformappobject_file Property to override name of classlib containing form mediator class. cappcode_file Property to override name of program file containing code to add to form containing mediator object. ninstallmediator Determines how meditator is installed (0-prompts, 1-never installs, 2-always installs). *setbuilderref Sets object reference to application builder. *addappobject Adds mediator object to form to enable with application framework. *addappobjectcode Adds code to form to work with mediator object.  %7[UaT %CCCC OT APPBLDR.SCXTC HoZ C0T CCQ0TCQ CCQWIZARDS\0 TCQWIZARDS\2Z'TCSCX|VCX AppBuilder:%C C0 VTBU LCAPPBLDRTHISCBUILDER .%CtoFormRef.Parent.FormCountbN[B-%CL T-T %CCCC T app_mediatorT %CCCC T _formmediatorT %CCCC gT _framewk.vcxYIF TYPE("toFormRef.&lcAppObject..BaseClass")="C" AND toFormRef.Parent.FormCount=1B%CpWould you like to add a mediator object to this form to fully enable it for use with the application framework? C C C C ٘If you choose Yes, code may also be added to the form's QueryUnload event to allow the mediator object to detect unsaved changes when closing the form. C C C C ROnce opened in the designer, you must save the form for these changes to persist. $x |BTC H& C0 CCQWIZARDS\0TCQWIZARDS\ CCQ0TCQ2&B-T ( TC %CfFORM.,IF TYPE("oFormRef.&lcAppObject")="O".CCCCU TOFORMREFTLFORCEMEDIATOR LCAPPCLASSLIB LCAPPOBJECT LCAPPCLASSI OFORMSETREFOFORMREFTHISCFORMAPPOBJECT_NAMECFORMAPPOBJECT_CLASSCFORMAPPOBJECT_FILEPARENT FORMCOUNTOBJECTS BASECLASS NEWOBJECTADDAPPOBJECTCODE]/%COCf FORM  =B- TT %CCCC T app_mediatorTC!TCC QueryUnLoadU%CC App_Mediator CtoFormRef.WizAppClassbU 7BT %CCCC T TFRM_QUL.PRG H C0 CCQ0TCQ CCQWIZARDS\0TCQWIZARDS\2 T%C =TC%C4TC C DT'*** Begin form mediator object code ***C C 0TDO CASEC C C C =TCASE NOT DODEFAULT()C C C C 'T NODEFAULTC C 4T RETURN .F.C C C C OTCASE ( TYPE("THIS..BaseClass")="C" ) AND ;C C MT ( NOT THIS..QueryUnload() )C C C C 'T NODEFAULTC C 4T RETURN .F.C C C C 2T OTHERWISEC C C C 4T * continueC C C C $TENDCASEC C BT%*** End form mediator object code ***C C "C QueryUnLoad U TOFORMREF BASECLASSLCSTR LCMETHODCODE LCCODEFILE LCAPPOBJECTTHISCFORMAPPOBJECT_NAME READMETHOD CAPPCODE_FILE WRITEMETHOD%CL5T-0%C_oAppBldr.oProject.BaseClassbCS%odCVThe Application Builder is still open. Would you like to update with any changes made?$x   C%C ) C OT7_oAppBldr.Activate'%C_oAppBldr.BaseClassbC%C {2ALT+F11T ON KEY LABEL ALT+F11 &lcCmd. TU NSAVEUPDATEOPROJECTLCMDTHIS LAUTOUPDATE _OAPPBLDRNAMECPROJECT SETAPPPEMSPROJECTSCOUNTRELEASE CSAVEONKEYALTF11LCCMDOBUILDER  TCCf!%C SCX,FRX,LBXVB%CLT-% &'%C_oappbldr.baseclassbC#<PROJECTAPP'%C_oappbldr.baseclassbC B-C%CNRT%nB%SCXCpWould you like to add a mediator object to this form to fully enable it for use with the application framework? C C C C ٘If you choose Yes, code may also be added to the form's QueryUnload event to allow the mediator object to detect unsaved changes when closing the form. C C C C ]Note: if a mediator already exists, neither the mediator nor the form code will be modified. $x   /&:%C`}CCa\{CTRL-W}U CFILENAMELCEXTLASELOBJTHISLBYPASSBUILDER _OAPPBLDRADDDOCNINSTALLMEDIATOR ADDAPPOBJECT# %BaiR,YApphook class loaded. Right-click on project or press ALT+F11 to run Application Builder. CTC/T"DO (_WIZARD) WITH 'PROJECT',,'APP' TCKEYALT+F11 ON KEY LABEL ALT+F11 &lcCmd. U TLTESTMODELCCMDTHIS SETBUILDERREFCPROJECT ACTIVEPROJECTNAME CSAVEONKEYp "%C L WB-+%C oFile.NamebC C 0 B-K%CC /SCX,FRX,LBX,VCX,PRG,FXP,APP,EXE,MPR,MPX,QPR,QPXB0TCC C _app.DBF%C0 (B'%C_oappbldr.baseclassbCjC BTCTCC fTCC f TCWT C %  FF Q%CC FB H'I! CFRXSCXLBX$TCSCXFR6:Cf CCf CC C'  VCX. CC CCf C' 5 CPRG,FXP,APP,EXE,MPR,MPX,QPR,QPXI,CC CCf C' % _Q FUOFILE CCLASSNAME IDELETEFILELCEXT LCFILENAME LCDOCTYPE LCMETADBF LNSAVEAREA LCMETAALIAS LMETAUSEDTHISLBYPASSBUILDERNAMECPROJECT _OAPPBLDR REMOVEDOCDOC_TYPEDOC_WRAPDOC_EXEC DOC_CLASS setbuilderref, addappobjectaddappobjectcodeDestroyt QueryAddFileInitQueryRemoveFile1qA1AqAAA3qARAAAAAAAA1qArAAAAB3qqA2ASAAA2AAQAqAqA!AA!A"3AAaAAr!1AA3q"AAAq1qqAAAACAAQAA3qqArQ3"qAqAAAAAs1AAQQAAAAAQAAA24W H ky<_| )Height = 27 Width = 58 obuilder = cbuilder = (HOME()+"WIZARDS\APPBLDR.SCX") cproject = csaveonkey = cformappobject_name = cformappobject_class = cformappobject_file = cappcode_file = ninstallmediator = 0 Name = "apphook" VPROCEDURE trimfile LPARAMETERS tcFileName LOCAL lcFileName,lnAtPos lnAtPos=RATC("\",tcFileName) lcFileName=ALLTRIM(IIF(lnAtPos=0,tcFileName,LEFTC(tcFileName,lnAtPos))) RETURN LOWER(lcFileName) ENDPROC PROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. RELEASE this ENDPROC `Width = 336 Height = 125 BorderWidth = 0 clastprojectfile = cext = .pjx Name = "_folder"  container PROCEDURE setbuilderref LOCAL lcAppBldr lcAppBldr = THIS.cBuilder IF VARTYPE(lcAppBldr)#"C" OR EMPTY(ALLTRIM(lcAppBldr)) lcAppBldr = APPBLDR_FILE ENDIF lcAppBldr = ALLTRIM(lcAppBldr) DO CASE CASE FILE(lcAppBldr) THIS.cBuilder = lcAppBldr CASE FILE(HOME()+lcAppBldr) THIS.cBuilder = HOME()+lcAppBldr CASE FILE(HOME()+"WIZARDS\"+lcAppBldr) THIS.cBuilder = HOME()+"WIZARDS\"+lcAppBldr OTHERWISE THIS.cBuilder = GETFILE("SCX|VCX","AppBuilder:") IF EMPTY(THIS.cBuilder ) OR !FILE(THIS.cBuilder) THIS.cBuilder = "" RETURN ENDIF ENDCASE ENDPROC PROCEDURE addappobject * Adds application object to form (form_mediator object). LPARAMETER toFormRef, tlForceMediator LOCAL lcAppClassLib, lcAppObject, lcAppClass, i, oFormSetRef, oFormRef IF TYPE("toFormRef.Parent.FormCount")#"N" RETURN .F. ENDIF IF VARTYPE(tlForceMediator)#"L" tlForceMediator = .F. ENDIF * Name given to mediator object when added to form lcAppObject = THIS.cFormAppObject_Name IF VARTYPE(lcAppObject)#"C" OR EMPTY(ALLTRIM(lcAppObject)) lcAppObject = FRMOBJECT_NAME && "app_mediator" ENDIF * Name of class used for mediator object lcAppClass = THIS.cFormAppObject_Class IF VARTYPE(lcAppClass)#"C" OR EMPTY(ALLTRIM(lcAppClass)) lcAppClass = FRMOBJECT_CLASS && "_formmediator" ENDIF * Name of classlib containing class used for mediator object lcAppClassLib = THIS.cFormAppObject_File IF VARTYPE(lcAppClassLib)#"C" OR EMPTY(ALLTRIM(lcAppClassLib)) lcAppClassLib = FRMOBJECT_FILE && "_framewk.vcx" ENDIF * Check if form mediator object already added IF TYPE("toFormRef.&lcAppObject..BaseClass")="C" AND toFormRef.Parent.FormCount=1 RETURN ENDIF * tlForceMediator = .T. if coming from QueryAddObject * Messagebox triggered from App Builder Form Edit or other IF tlForceMediator OR; MESSAGEBOX(ADDAPPOBJ_LOC+CRLF+CRLF+ADDAPPOBJ2_LOC+CRLF+CRLF+ADDAPPOBJ4_LOC,36)=6 * Continue ELSE RETURN ENDIF lcAppClassLib = ALLTRIM(lcAppClassLib) DO CASE CASE FILE(lcAppClassLib) * Continue CASE FILE(HOME()+"WIZARDS\"+lcAppClassLib) lcAppClassLib = HOME()+"WIZARDS\"+lcAppClassLib CASE FILE(HOME()+lcAppClassLib) lcAppClassLib = HOME()+lcAppClassLib OTHERWISE RETURN .F. ENDCASE oFormSetRef = toFormRef.Parent FOR i = 1 TO oFormSetRef.FormCount oFormRef = oFormSetRef.Objects[m.i] * Check for Toolbar IF UPPER(oFormRef.BaseClass)#"FORM" LOOP ENDIF * Check if form mediator object already added IF TYPE("oFormRef.&lcAppObject")="O" LOOP ENDIF * Add Form Mediator object to form oFormRef.Newobject(ALLTRIM(lcAppObject), ALLTRIM(lcAppClass), lcAppClassLib) * Add Code THIS.AddAppObjectCode(oFormRef) ENDFOR ENDPROC PROCEDURE addappobjectcode LPARAMETER toFormRef IF VARTYPE(toFormRef)#"O" AND UPPER(toFormRef.BaseClass)+" " # "FORM " RETURN .F. ENDIF LOCAL lcStr, lcMethodCode, lcCodeFile, lcAppObject lcStr = "" * Name given to mediator object when added to form lcAppObject = THIS.cFormAppObject_Name IF VARTYPE(lcAppObject)#"C" OR EMPTY(ALLTRIM(lcAppObject)) lcAppObject = FRMOBJECT_NAME && "app_mediator" ENDIF lcAppObject = ALLTRIM(lcAppObject) * Check if code already exists. This is simple test * which only checks if reference to APP_MEDIATOR exists. * Also checks for Form Wizard class and skips since it * has special code already. lcMethodCode = ALLTRIM(toFormRef.ReadMethod("QueryUnLoad")) IF ATC(lcAppObject,lcMethodCode)#0 OR; ATC("App_Mediator",lcMethodCode)#0 OR; TYPE("toFormRef.WizAppClass")#"U" RETURN ENDIF lcCodeFile = THIS.cAppCode_File IF VARTYPE(lcCodeFile)#"C" OR EMPTY(ALLTRIM(lcCodeFile)) lcCodeFile = QUERYUNLOADCODE_FILE && QueryUnload file ENDIF DO CASE CASE FILE(lcCodeFile) * Continue CASE FILE(HOME()+lcCodeFile) lcCodeFile = HOME()+lcCodeFile CASE FILE(HOME()+"WIZARDS\"+lcCodeFile) lcCodeFile = HOME()+"WIZARDS\"+lcCodeFile OTHERWISE lcCodeFile = "" ENDCASE IF !EMPTY(lcCodeFile) lcStr = FILETOSTR(lcCodeFile) ENDIF IF EMPTY(lcStr) lcStr = CRLF lcStr = lcStr + [*** Begin form mediator object code ***] + CRLF lcStr = lcStr + [DO CASE] + CRLF + CRLF lcStr = lcStr + [CASE NOT DODEFAULT()] + CRLF + CRLF lcStr = lcStr + [ NODEFAULT] + CRLF lcStr = lcStr + [ RETURN .F.] + CRLF + CRLF lcStr = lcStr + [CASE ( TYPE("THIS.]+lcAppObject+[.BaseClass")="C" ) AND ;] + CRLF lcStr = lcStr + [ ( NOT THIS.]+lcAppObject+[.QueryUnload() )] + CRLF + CRLF lcStr = lcStr + [ NODEFAULT] + CRLF lcStr = lcStr + [ RETURN .F.] + CRLF + CRLF lcStr = lcStr + [OTHERWISE] + CRLF + CRLF lcStr = lcStr + [ * continue] + CRLF + CRLF lcStr = lcStr + [ENDCASE] + CRLF lcStr = lcStr + [*** End form mediator object code ***] + CRLF ENDIF toFormRef.WriteMethod("QueryUnLoad",lcStr + lcMethodCode) ENDPROC PROCEDURE Destroy LOCAL nSaveUpdate,oProject,lCmd IF VARTYPE(THIS.lAutoUpdate)#"L" THIS.lAutoUpdate = .F. ENDIF IF TYPE("_oAppBldr.oProject.BaseClass")="C" IF _oAppBldr.oProject.Name=THIS.cProject AND; (THIS.lAutoUpdate OR MESSAGEBOX(CLOSEAPPBLDR_LOC,36)=6) _oAppBldr.SetAppPems() ENDIF IF _vfp.projects.count=1 _oAppBldr.Release() ELSE _SHELL="_oAppBldr.Activate" ENDIF ENDIF IF TYPE("_oAppBldr.BaseClass")#"C" IF EMPTY(THIS.cSaveONKey) ON KEY LABEL ALT+F11 ELSE lcCmd=THIS.cSaveONKey ON KEY LABEL ALT+F11 &lcCmd. ENDIF ENDIF THIS.oBuilder = null ENDPROC PROCEDURE QueryAddFile LPARAMETERS cFileName LOCAL lcExt,laSelObj DIMENSION laSelObj[1] lcExt = UPPER(JUSTEXT(cFileName)) IF ATC(lcExt,"SCX,FRX,LBX")=0 RETURN ENDIF IF VARTYPE(THIS.lByPassBuilder)#"L" THIS.lByPassBuilder=.F. ENDIF IF !THIS.lByPassBuilder IF TYPE("_oappbldr.baseclass")#"C" DO (_WIZARD) WITH "PROJECT",,"APP" IF TYPE("_oappbldr.baseclass")#"C" RETURN .F. ENDIF ENDIF _oappbldr.AddDoc(cFileName) ENDIF IF VARTYPE(THIS.nInstallMediator)#"N" THIS.nInstallMediator=0 ENDIF * Never wants Form Mediator object IF THIS.nInstallMediator=1 RETURN ENDIF IF lcExt="SCX" AND (THIS.nInstallMediator=2 OR; MESSAGEBOX(ADDAPPOBJ_LOC+CRLF+CRLF+ADDAPPOBJ2_LOC+CRLF+CRLF+ADDAPPOBJ3_LOC,36)=6) MODI FORM (cFileName) NOWAIT IF ASELOBJ(laSelObj,1)=1 THIS.AddAppObject(laSelObj[1],.T.) ENDIF KEYBOARD "{CTRL-W}" ENDIF ENDPROC PROCEDURE Init LPARAMETERS tlTestMode IF tlTestMode RETURN .T. ENDIF LOCAL lcCmd WAIT WINDOW LOADMSG_LOC TIMEOUT 2 THIS.SetBuilderRef() THIS.cProject = _VFP.ActiveProject.Name lcCmd = "DO (_WIZARD) WITH 'PROJECT',,'APP'" THIS.cSaveONKey = ON("KEY","ALT+F11") ON KEY LABEL ALT+F11 &lcCmd. ENDPROC PROCEDURE QueryRemoveFile LPARAMETERS oFile, cClassName, IDeleteFile LOCAL lcExt,lcFileName,lcDocType,lcMetaDBF,lnSaveArea,lcMetaAlias,lMetaUsed IF VARTYPE(THIS.lByPassBuilder)="L" AND THIS.lByPassBuilder RETURN .F. ENDIF IF TYPE("oFile.Name")#"C" OR !FILE(oFile.Name) RETURN .F. ENDIF IF ATC(JUSTEXT(oFile.Name),"SCX,FRX,LBX,VCX,PRG,FXP,APP,EXE,MPR,MPX,QPR,QPX")=0 RETURN ENDIF lcMetaDBF = ADDBS(JUSTPATH(THIS.cProject))+; JUSTSTEM(THIS.cProject)+APP_BUILDER_FILE_SUFFIX+".DBF" * Need to remove from Meta table if one exists IF !FILE(lcMetaDBF) RETURN ENDIF * Use builder if its open IF TYPE("_oappbldr.baseclass")="C" _oappbldr.RemoveDoc(oFile.Name) RETURN ENDIF lcMetaAlias = JUSTSTEM(lcMetaDBF) lcExt = UPPER(JUSTEXT(oFile.Name)) lcFileName = UPPER(JUSTSTEM(oFile.Name)) lnSaveArea = SELECT() lMetaUsed = USED(lcMetaAlias) IF lMetaUsed SELECT (lcMetaAlias) ELSE SELECT 0 USE (lcMetaDBF) AGAIN SHARED IF EMPTY(ALIAS()) SELECT (lnSaveArea) RETURN ENDIF ENDIF DO CASE CASE INLIST(lcExt,"FRX","SCX","LBX") lcDocType = IIF(lcExt="SCX","F","R") DELETE ALL FOR UPPER(doc_type) = lcDocType AND !doc_wrap AND; UPPER(ALLTRIM(doc_exec))== lcFileName AND; EMPTY(ALLTRIM(doc_class)) AND NOT DELETED() CASE lcExt = "VCX" DELETE ALL FOR !doc_wrap AND !EMPTY(ALLTRIM(doc_class)) AND; UPPER(ALLTRIM(doc_exec))== lcFileName AND NOT DELETED() CASE ATC(lcExt,"PRG,FXP,APP,EXE,MPR,MPX,QPR,QPX")#0 DELETE ALL FOR doc_wrap AND EMPTY(ALLTRIM(doc_class)) AND; UPPER(ALLTRIM(doc_exec))== lcFileName AND NOT DELETED() ENDCASE IF !lMetaUsed USE ENDIF SELECT (lnSaveArea) ENDPROC